home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / FPE / FPEDlg.mod < prev    next >
Text File  |  1995-06-29  |  25KB  |  896 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: FPEDlg.mod $
  4.   Description: Displays and handles the main dialog for the FPE utility.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.16 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/29 18:49:53 $
  10.  
  11.   Copyright © 1993-1995, Frank Copeland.
  12.   This file is part of FPE.
  13.   See FPE.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *> <* MAIN- *> <*$ NilChk- *>
  20.  
  21. MODULE FPEDlg;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, Errors, e := Exec, eu := ExecUtil, d := Dos,
  25.   i := Intuition, ASL, iu := IntuiUtil, ev := Events, ASLUtil,
  26.   is := IntuiSup, isu := IntuiSupUtil, ise := ISupEvents,
  27.   str := Strings, Data, tpl := FPETpl, sd := StringDialog, td := ToolDlg;
  28.  
  29.  
  30. (* ===== Dialog Window ===== *)
  31.  
  32. CONST
  33.  
  34. (* Gadget IDs *)
  35.  
  36.   ModuleID      = 0;
  37.  
  38.   FilesID       = ModuleID + 1;
  39.   LastFilesID   = ModuleID + Data.NumFiles;
  40.  
  41.   ButtonsID     = LastFilesID + 1;
  42.   LastButtonsID = LastFilesID + Data.NumTools;
  43.  
  44. (* Menu data indexes *)
  45.  
  46.   FPEIdx                   = 0;
  47.     AboutItemIdx             = 1;
  48.     QuitItemIdx              = 2;
  49.  
  50.   ProgramIdx               = 3;
  51.     CreateDirIdx             = 4;
  52.     OpenItemIdx              = 5;
  53.     AddModuleItemIdx         = 6;
  54.     RemoveModuleItemIdx      = 7;
  55.     SaveItemIdx              = 8;
  56.  
  57.   SetupIdx                 = 9;
  58.     LoadItemIdx              = 10;
  59.       LoadDefaultIdx           = 11;
  60.       LoadAltIdx               = 12;
  61.       LoadSelectIdx            = 13;
  62.     SaveSetupItemIdx         = 14;
  63.       SaveDefaultIdx           = 15;
  64.       SaveAltIdx               = 16;
  65.       SaveSelectIdx            = 17;
  66.     ButtonsItemIdx           = 18;
  67.       FirstButtonsSubItemIdx   = ButtonsItemIdx + 1;
  68.       LastButtonsSubItemIdx    = ButtonsItemIdx + Data.NumTools;
  69.     FilesItemIdx             = LastButtonsSubItemIdx + 1;
  70.       FirstFilesSubItemIdx     = FilesItemIdx + 1;
  71.       LastFilesSubItemIdx      = FilesItemIdx + Data.NumFiles;
  72.  
  73.   NumMenus = LastFilesSubItemIdx + 1;
  74.  
  75. (* Menu IDs *)
  76.  
  77.   FPEID               = 0;
  78.     AboutItemID         = 0;
  79.     QuitItemID          = 1;
  80.  
  81.   ProgramID           = 1;
  82.     CreateDirID         = 0;
  83.     OpenItemID          = 1;
  84.     AddModuleItemID     = 2;
  85.     RemoveModuleItemID  = 3;
  86.     SaveItemID          = 4;
  87.  
  88.   SetupID             = 2;
  89.     LoadItemID          = 0;
  90.       LoadDefaultID       = 0;
  91.       LoadAltID           = 1;
  92.       LoadSelectID        = 2;
  93.     SaveSetupItemID     = 1;
  94.       SaveDefaultID       = 0;
  95.       SaveAltID           = 1;
  96.       SaveSelectID        = 2;
  97.     ButtonsItemID       = 2;
  98.     FilesItemID         = 3;
  99.  
  100. VAR
  101.  
  102.   renderInfo         : is.RenderInfoPtr;
  103.   newWindow          : i.NewWindow;
  104.   window             : i.WindowPtr;
  105.   programNameBuffer  : ARRAY Data.FileChars + 1 OF CHAR;
  106.   template           : tpl.Template;
  107.   gadgetList         : is.GadgetList;
  108.   menuData           : ARRAY NumMenus + 1 OF is.MenuData;
  109.   menuList           : is.MenuList;
  110.  
  111.  
  112. CONST
  113.   WindowTitle = "FPE 1.12 (21.6.95)";
  114.   ScreenTitle = "Frank's Programming Environment";
  115.  
  116.  
  117. (* ===== Dialog Handler ===== *)
  118.  
  119. TYPE
  120.  
  121.   Handler = POINTER TO HandlerRec;
  122.   HandlerRec = RECORD (ise.ISupPortRec) END;
  123.  
  124. CONST
  125.   IDCMPFlags = tpl.GadgetIDCMPFlags + {i.closeWindow, i.menuPick};
  126.  
  127. VAR
  128.   setupDir  : Data.Path;
  129.   setupFile : Data.FileName;
  130.   handler   : Handler;
  131.  
  132. (* ===== Miscellaneous ===== *)
  133.  
  134. CONST
  135.  
  136.   OutOfMemory = "FPE : Out of memory";
  137.  
  138.  
  139. (*------------------------------------------------------------------------*)
  140. (* Local procedures *)
  141.  
  142.  
  143. PROCEDURE* Cleanup (VAR rc : LONGINT);
  144.  
  145. BEGIN (* Cleanup *)
  146.   IF menuList # NIL   THEN is.FreeMenu (menuList) END;
  147.   IF gadgetList # NIL THEN is.FreeGadgets (gadgetList) END;
  148.   IF renderInfo # NIL THEN is.FreeRenderInfo (renderInfo) END;
  149.   tpl.Cleanup (template);
  150. END Cleanup;
  151.  
  152.  
  153. (* ---------------------------------------------------------------------- *)
  154. (* ===== Dialog window procedures ===== *)
  155.  
  156.  
  157. (*------------------------------------*)
  158. PROCEDURE Init * ();
  159.  
  160.   PROCEDURE InitGadgets ();
  161.  
  162.     VAR index, result : INTEGER;
  163.  
  164.   BEGIN (* InitGadgets *)
  165.     index := 0;
  166.     WHILE index < Data.NumFiles DO
  167.       template.GadgetData.g1 [index].text :=
  168.         SYS.ADR (Data.extensions [index]);
  169.       INC (index);
  170.     END; (* WHILE *)
  171.  
  172.     index := 0;
  173.     WHILE index < Data.NumTools DO
  174.       template.GadgetData.g2 [index].text  :=
  175.         SYS.ADR (Data.tools [index].title);
  176.       INC (index)
  177.     END; (* WHILE *)
  178.  
  179.     template.TextData[1].text := SYS.ADR(programNameBuffer);
  180.  
  181.     renderInfo :=
  182.       is.GetRenderInfo (NIL, tpl.RenderInfoFlags);
  183.     Errors.Assert (renderInfo # NIL, "FPE : failed to get render info");
  184.     renderInfo.textPen1 := renderInfo.shadowPen;
  185.     renderInfo.textPen2 := renderInfo.highlightPen;
  186.  
  187.     gadgetList :=
  188.       is.CreateGadgets
  189.         (renderInfo, template.GadgetData.g0, 0, 0, NIL);
  190.     Errors.Assert (gadgetList # NIL, "FPE : failed to create gadgets");
  191.   END InitGadgets;
  192.  
  193.   PROCEDURE InitMenus ();
  194.  
  195.     CONST
  196.       On = {}; Off = {is.mdDisabled};
  197.  
  198.     VAR index : INTEGER;
  199.  
  200.   BEGIN (* InitMenus *)
  201.     menuData [FPEIdx].type := is.title;
  202.     menuData [FPEIdx].flags := On;
  203.     menuData [FPEIdx].name := SYS.ADR("FPE");
  204.  
  205.       menuData [AboutItemIdx].type := is.item;
  206.       menuData [AboutItemIdx].flags := On;
  207.       menuData [AboutItemIdx].name := SYS.ADR("About ...");
  208.  
  209.       menuData [QuitItemIdx].type := is.item;
  210.       menuData [QuitItemIdx].flags := On;
  211.       menuData [QuitItemIdx].name := SYS.ADR("Quit");
  212.       menuData [QuitItemIdx].commandKey := SYS.ADR("Q");
  213.  
  214.     menuData [ProgramIdx].type := is.title;
  215.     menuData [ProgramIdx].flags := On;
  216.     menuData [ProgramIdx].name := SYS.ADR("Project");
  217.  
  218.       menuData [CreateDirIdx].type := is.item;
  219.       menuData [CreateDirIdx].flags := On;
  220.       menuData [CreateDirIdx].name := SYS.ADR("Create Directory ...");
  221.  
  222.       menuData [OpenItemIdx].type := is.item;
  223.       menuData [OpenItemIdx].flags := On;
  224.       menuData [OpenItemIdx].name := SYS.ADR("Select Project ...");
  225.  
  226.       menuData [AddModuleItemIdx].type := is.item;
  227.       menuData [AddModuleItemIdx].flags := On;
  228.       menuData [AddModuleItemIdx].name := SYS.ADR("Add Module ...");
  229.  
  230.       menuData [RemoveModuleItemIdx].type := is.item;
  231.       menuData [RemoveModuleItemIdx].flags := On;
  232.       menuData [RemoveModuleItemIdx].name := SYS.ADR("Remove Module ...");
  233.  
  234.       menuData [SaveItemIdx].type := is.item;
  235.       menuData [SaveItemIdx].flags := On;
  236.       menuData [SaveItemIdx].name := SYS.ADR("Save Module List");
  237.  
  238.     menuData [SetupIdx].type := is.title;
  239.     menuData [SetupIdx].flags := On;
  240.     menuData [SetupIdx].name := SYS.ADR("Setup");
  241.  
  242.       menuData [LoadItemIdx].type := is.item;
  243.       menuData [LoadItemIdx].flags := On;
  244.       menuData [LoadItemIdx].name := SYS.ADR("Load Setup");
  245.  
  246.         menuData [LoadDefaultIdx].type := is.subItem;
  247.         menuData [LoadDefaultIdx].flags := On;
  248.         menuData [LoadDefaultIdx].name := SYS.ADR ("Default Setup");
  249.  
  250.         menuData [LoadAltIdx].type := is.subItem;
  251.         menuData [LoadAltIdx].flags := On;
  252.         menuData [LoadAltIdx].name := SYS.ADR ("Alternate Setup");
  253.  
  254.         menuData [LoadSelectIdx].type := is.subItem;
  255.         menuData [LoadSelectIdx].flags := On;
  256.         menuData [LoadSelectIdx].name := SYS.ADR ("Select Setup ...");
  257.  
  258.       menuData [SaveSetupItemIdx].type := is.item;
  259.       menuData [SaveSetupItemIdx].flags := On;
  260.       menuData [SaveSetupItemIdx].name := SYS.ADR("Save Setup");
  261.  
  262.         menuData [SaveDefaultIdx].type := is.subItem;
  263.         menuData [SaveDefaultIdx].flags := On;
  264.         menuData [SaveDefaultIdx].name := SYS.ADR ("Default Setup");
  265.  
  266.         menuData [SaveAltIdx].type := is.subItem;
  267.         menuData [SaveAltIdx].flags := On;
  268.         menuData [SaveAltIdx].name := SYS.ADR ("Alternate Setup");
  269.  
  270.         menuData [SaveSelectIdx].type := is.subItem;
  271.         menuData [SaveSelectIdx].flags := On;
  272.         menuData [SaveSelectIdx].name := SYS.ADR ("Select Setup ...");
  273.  
  274.       menuData [ButtonsItemIdx].type := is.item;
  275.       menuData [ButtonsItemIdx].flags := On;
  276.       menuData [ButtonsItemIdx].name := SYS.ADR("Edit Tool Button");
  277.  
  278.         index := 0;
  279.         WHILE index < Data.NumTools DO
  280.           menuData [index + FirstButtonsSubItemIdx].type := is.subItem;
  281.           menuData [index + FirstButtonsSubItemIdx].flags := On;
  282.           menuData [index + FirstButtonsSubItemIdx].name := SYS.ADR (Data.tools [index].title);
  283.           INC( index );
  284.         END; (* WHILE *)
  285.  
  286.       menuData [FilesItemIdx].type := is.item;
  287.       menuData [FilesItemIdx].flags := On;
  288.       menuData [FilesItemIdx].name := SYS.ADR("Edit File Extension");
  289.  
  290.         index := 0;
  291.         WHILE index < Data.NumFiles DO
  292.           menuData [index + FirstFilesSubItemIdx].type := is.subItem;
  293.           menuData [index + FirstFilesSubItemIdx].flags := On;
  294.           menuData [index + FirstFilesSubItemIdx].name := SYS.ADR (Data.extensions [index]);
  295.           INC( index );
  296.         END; (* WHILE *)
  297.  
  298.     menuData [NumMenus].type := is.dataEnd;
  299.   END InitMenus;
  300.  
  301.   PROCEDURE InitWindow ();
  302.  
  303.   BEGIN (* InitWindow *)
  304.     window := NIL;
  305.     newWindow.leftEdge   := tpl.LeftEdge;
  306.     newWindow.topEdge    := tpl.TopEdge;
  307.     newWindow.width      := tpl.Width;
  308.     newWindow.height     := tpl.Height;
  309.     newWindow.blockPen   := 1;
  310.     newWindow.idcmpFlags := {};
  311.     newWindow.flags      := tpl.WindowFlags;
  312.     newWindow.title      := SYS.ADR(WindowTitle);
  313.     newWindow.type       := {i.wbenchScreen};
  314.     newWindow.minWidth   := 80;   newWindow.minHeight := 30;
  315.     newWindow.maxWidth   := 1024; newWindow.maxHeight := 1024;
  316.   END InitWindow;
  317.  
  318. BEGIN (* Init *)
  319.   tpl.Init (template);
  320.   Kernel.SetCleanup (Cleanup);
  321.   InitGadgets ();
  322.   InitMenus();
  323.   InitWindow();
  324. END Init;
  325.  
  326.  
  327. (*------------------------------------*)
  328. PROCEDURE KillModuleList ();
  329.  
  330.   CONST
  331.     Disable = {is.gdDisabled}; NoFlags = {};
  332.  
  333.   VAR ignore : LONGINT;
  334.  
  335. BEGIN (* KillModuleList *)
  336.   ignore := is.SetGadgetAttributes
  337.     (gadgetList, ModuleID, Disable, Disable, is.useCurrentValue, 0, NIL);
  338. END KillModuleList;
  339.  
  340.  
  341. (*------------------------------------*)
  342. PROCEDURE RefreshModuleList ();
  343.  
  344.   CONST
  345.     Disable = {is.gdDisabled}; NoFlags = {};
  346.  
  347.   VAR ignore : LONGINT;
  348.  
  349. BEGIN (* RefreshModuleList *)
  350.   IF eu.ListLength (Data.moduleList) = 0 THEN
  351.     ignore := is.SetGadgetAttributes
  352.       ( gadgetList, ModuleID, Disable, Disable, is.useCurrentValue, 0,
  353.         NIL);
  354.   ELSE
  355.     ignore := is.SetGadgetAttributes
  356.       ( gadgetList, ModuleID, Disable, NoFlags, is.useCurrentValue,
  357.         Data.currentModuleNo, SYS.ADR (Data.moduleList));
  358.   END
  359. END RefreshModuleList;
  360.  
  361.  
  362. (*------------------------------------*)
  363. PROCEDURE Display ();
  364.  
  365.   VAR index, left, top, width, height : INTEGER;
  366.  
  367. BEGIN (* Display *)
  368.   left := window.borderLeft; top := window.borderTop;
  369.   width := window.width - left - window.borderRight;
  370.   height := window.height - top - window.borderBottom;
  371.   is.ClearWindow (renderInfo, window, left, top, width, height, {});
  372.   is.DisplayGadgets (window, gadgetList);
  373.   is.DisplayTextsPtr
  374.     (renderInfo, window, template.TextData, 0, 0, NIL);
  375.   is.DisplayBordersPtr
  376.     (renderInfo, window, template.BorderData, 0, 0);
  377.  
  378.   index := 0;
  379.   WHILE index < Data.NumFiles DO
  380.     isu.SelectGadget
  381.       (gadgetList, FilesID + index, index IN Data.currentFiles);
  382.     INC (index)
  383.   END; (* WHILE *)
  384.  
  385.   index := 0;
  386.   WHILE index < Data.NumTools DO
  387.     isu.DisableGadget
  388.       (gadgetList, ButtonsID + index, ~Data.tools [index].isActive);
  389.     INC (index);
  390.   END; (* WHILE *)
  391.   RefreshModuleList ();
  392. END Display;
  393.  
  394.  
  395. (*------------------------------------*)
  396. PROCEDURE * Close (VAR rc : LONGINT);
  397.  
  398.   VAR ignore : i.WindowPtr;
  399.  
  400. BEGIN (* Close *)
  401.   IF gadgetList # NIL THEN ignore := is.RemoveGadgets (gadgetList) END;
  402.   IF menuList # NIL THEN ignore := is.RemoveMenu (menuList) END;
  403.   IF window # NIL THEN is.CloseWindow (window, e.LFALSE); window := NIL END
  404. END Close;
  405.  
  406.  
  407. (*------------------------------------*)
  408. PROCEDURE Open * ();
  409.  
  410. BEGIN (* Open *)
  411.   window :=
  412.     is.OpenWindow (renderInfo, SYS.VAL (i.NewWindowBase, newWindow), tpl.OpenWindowFlags);
  413.   Errors.Assert (window # NIL, "FPE - IOpenWindow() failed");
  414.   Kernel.SetCleanup (Close);
  415.  
  416.   i.SetWindowTitles
  417.     (window, SYS.ADR (WindowTitle), SYS.ADR (ScreenTitle));
  418.  
  419.   menuList :=
  420.     is.CreateMenuA (renderInfo, window, menuData, NIL, NIL);
  421.   Errors.Assert (menuList # NIL, "FPE - ICreateMenu() failed");
  422.   is.AttachMenu (window, menuList);
  423.  
  424.   Display ();
  425. END Open;
  426.  
  427.  
  428. (*------------------------------------*)
  429. PROCEDURE ShowMessage ( message : ARRAY OF CHAR );
  430.  
  431. <*$CopyArrays-*>
  432. BEGIN (* ShowMessage *)
  433.   isu.DoNotice (window, SYS.ADR("*** FPE Message ***"), message)
  434. END ShowMessage;
  435.  
  436.  
  437. (*------------------------------------*)
  438. PROCEDURE RefreshProgramName ();
  439.  
  440. BEGIN (* RefreshProgramName *)
  441.   programNameBuffer := "                              ";
  442.   str.Replace (Data.programName, 0, programNameBuffer);
  443.   is.DisplayTextsPtr
  444.     (renderInfo, window, template.TextData, 0, 0, NIL);
  445. END RefreshProgramName;
  446.  
  447.  
  448. (*------------------------------------*)
  449. PROCEDURE RefreshWindow ();
  450.  
  451.   CONST Flags = {is.cwNormalColor};
  452.  
  453. BEGIN (* RefreshWindow *)
  454.   is.RefreshGadgets (gadgetList);
  455.   is.DisplayTextsPtr
  456.     (renderInfo, window, template.TextData, 0, 0, NIL);
  457.   is.DisplayBordersPtr
  458.     (renderInfo, window, template.BorderData, 0, 0);
  459. END RefreshWindow;
  460.  
  461.  
  462. (*------------------------------------*)
  463. PROCEDURE ResetGadgets ();
  464.  
  465.   VAR  window : i.WindowPtr;
  466.  
  467. BEGIN (* ResetGadgets *)
  468.   window := is.RemoveGadgets (gadgetList);
  469.   is.FreeGadgets (gadgetList);
  470.  
  471.   gadgetList :=
  472.     is.CreateGadgets
  473.       (renderInfo, template.GadgetData.g0, 0, 0, NIL);
  474.   Errors.Assert (gadgetList # NIL, "FPE : failed to reset gadgets");
  475.  
  476.   Display ();
  477. END ResetGadgets;
  478.  
  479.  
  480. (*------------------------------------------------------------------------*)
  481. (* ===== Dialog handler procedures ===== *)
  482.  
  483.  
  484. (*------------------------------------*)
  485. PROCEDURE DoLoadProgram (program : ARRAY OF CHAR);
  486.  
  487.   VAR message : ARRAY 60 OF CHAR;
  488.  
  489. <*$CopyArrays-*>
  490. BEGIN (* DoLoadProgram *)
  491.   is.ChangeMousePointerPtr (window, NIL, e.LFALSE);
  492.   KillModuleList ();
  493.   IF ~Data.LoadProgram (program) THEN
  494.     message := "Could not find ";
  495.     str.Append (program, message);
  496.     str.Append (".prg", message);
  497.     ShowMessage (message);
  498.     IF program [0] = 0X THEN
  499.       IF ~Data.ScanModules () THEN
  500.         ShowMessage ("Error scanning for modules");
  501.       END; (* IF *)
  502.     ELSE
  503.       Data.MakeModule (program);
  504.     END; (* IF *)
  505.   END; (* IF *)
  506.   RefreshProgramName ();
  507.   RefreshModuleList ();
  508.   is.RestoreMousePointer (window);
  509. END DoLoadProgram;
  510.  
  511.  
  512. (*------------------------------------*)
  513. PROCEDURE (handler : Handler) HandleISup
  514.   ( msg : i.IntuiMessagePtr)
  515.   : INTEGER;
  516.  
  517.   VAR gadget : LONGINT; value  : LONGINT;
  518.  
  519. BEGIN (* HandleISup *)
  520.   gadget := msg.code; value := SYS.VAL (LONGINT, msg.iAddress);
  521.   is.ReplyMsg (msg);
  522.  
  523.   CASE gadget OF
  524.     ModuleID :
  525.       Data.currentModule :=
  526.         SYS.VAL (Data.ModuleNodePtr, eu.NodeAt (Data.moduleList, value));
  527.       Data.currentModuleNo := value
  528.     |
  529.     FilesID .. LastFilesID :
  530.       IF value # 0 THEN
  531.         INCL (Data.currentFiles, gadget - FilesID);
  532.       ELSE
  533.         EXCL (Data.currentFiles, gadget - FilesID);
  534.       END
  535.     |
  536.     ButtonsID .. LastButtonsID :
  537.       Data.DoTool (SHORT (gadget) - ButtonsID)
  538.     |
  539.   ELSE
  540.   END; (* CASE gadget *)
  541.  
  542.   RETURN ev.Continue;
  543. END HandleISup;
  544.  
  545.  
  546. (*------------------------------------*)
  547. PROCEDURE (handler : Handler) HandleCloseWindow
  548.   ( msg : i.IntuiMessagePtr )
  549.   : INTEGER;
  550.  
  551. BEGIN (* HandleCloseWindow *)
  552.   e.ReplyMsg (msg);
  553.   RETURN ev.StopAll;
  554. END HandleCloseWindow;
  555.  
  556.  
  557. (*------------------------------------*)
  558. PROCEDURE (handler : Handler) HandleMenuPick
  559.   ( msg : i.IntuiMessagePtr )
  560.   : INTEGER;
  561.  
  562.   VAR
  563.     menuNumber, result : INTEGER; window : i.WindowPtr;
  564.     menuChoice : iu.Choice;
  565.  
  566.   (*------------------------------------*)
  567.   PROCEDURE DoAbout ();
  568.  
  569.     VAR ignore : BOOLEAN;
  570.  
  571.     BEGIN (* DoAbout *)
  572.       ignore :=
  573.         is.AutoRequest
  574.           ( window, SYS.ADR("About FPE"),
  575.             "FPE 1.12 (21.6.95)\\n"
  576.             "Frank's Programming Environment\\n"
  577.             "--oOo--\\n"
  578.             "Copyright © 1993-1995 Frank Copeland\\n"
  579.             "Written using Oberon-A\\n"
  580.             "and intuisup.library\\n\\n"
  581.             "see FPe.doc for conditions of use",
  582.             NIL, SYS.ADR("Continue"), {}, {},
  583.             { (*is.arBackFill,*) is.arMovePointerNeg,
  584.               is.arDrawRaster, is.arTextCenter },
  585.             NIL)
  586.     END DoAbout;
  587.  
  588.   (*------------------------------------*)
  589.   PROCEDURE DoCreateDir ();
  590.  
  591.     VAR
  592.       strDlg : sd.StrDlg; dirName : ARRAY 32 OF CHAR;
  593.       newDir : d.FileLockPtr; msg : ARRAY 60 OF CHAR;
  594.  
  595.     BEGIN (* DoCreateDir *)
  596.       NEW (strDlg);
  597.       IF strDlg # NIL THEN
  598.         sd.InitStrDlg
  599.           ( strDlg, renderInfo, "Create Directory", "Enter directory name",
  600.             31, 31);
  601.         dirName := "";
  602.         IF sd.Activate (strDlg, window, dirName) THEN
  603.           newDir := d.CreateDir (dirName);
  604.           IF newDir # NIL THEN
  605.             d.UnLock (newDir)
  606.           ELSE
  607.             msg := "Could not create directory : ";
  608.             str.Append (dirName, msg);
  609.             ShowMessage (msg);
  610.           END
  611.         END;
  612.         SYS.DISPOSE (strDlg)
  613.       ELSE ShowMessage (OutOfMemory)
  614.       END
  615.     END DoCreateDir;
  616.  
  617.   (*------------------------------------*)
  618.   PROCEDURE DoOpen;
  619.  
  620.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  621.  
  622.     BEGIN (* DoOpen *)
  623.       tempFile := ""; tempDir := Data.currentPath;
  624.       IF ASLUtil.RequestFile (window, "Select a project", tempFile, tempDir)
  625.       THEN
  626.         Data.ChangeDirectory (tempDir);
  627.         DoLoadProgram (tempFile)
  628.       END;
  629.     END DoOpen;
  630.  
  631.   (*------------------------------------*)
  632.   PROCEDURE DoSave ();
  633.  
  634.     VAR msg : ARRAY 60 OF CHAR;
  635.  
  636.     BEGIN (* DoSave *)
  637.       is.ChangeMousePointerPtr (window, NIL, e.LFALSE);
  638.       IF ~Data.SaveProgram() THEN
  639.         msg := "Could not save ";
  640.         str.Append (Data.programName, msg);
  641.         str.Append (".prg", msg);
  642.         ShowMessage (msg);
  643.       END; (* IF *)
  644.       is.RestoreMousePointer (window);
  645.     END DoSave;
  646.  
  647.   (*------------------------------------*)
  648.   PROCEDURE DoAddModule ();
  649.  
  650.     VAR strDlg : sd.StrDlg; module : Data.FileName;
  651.  
  652.     BEGIN (* DoAddModule *)
  653.       NEW (strDlg);
  654.       IF strDlg # NIL THEN
  655.         sd.InitStrDlg
  656.           ( strDlg, renderInfo, "Add Module",
  657.             "Enter a module name", Data.FileChars, Data.FileChars);
  658.         module := "";
  659.         IF sd.Activate (strDlg, window, module) THEN
  660.           Data.MakeModule (module);
  661.           RefreshModuleList ()
  662.         END;
  663.         SYS.DISPOSE (strDlg)
  664.       ELSE
  665.         ShowMessage (OutOfMemory)
  666.       END
  667.     END DoAddModule;
  668.  
  669.   (*------------------------------------*)
  670.   PROCEDURE DoRemoveModule ();
  671.  
  672.     BEGIN (* DoRemoveModule *)
  673.       IF
  674.         isu.DoRequest
  675.           ( window, SYS.ADR("Remove the current module?"),
  676.             "  Are you sure about this?  ")
  677.       THEN
  678.         Data.RemoveModule();
  679.         RefreshModuleList ()
  680.       END; (* IF *)
  681.     END DoRemoveModule;
  682.  
  683.   (*------------------------------------*)
  684.   PROCEDURE DoSetupFiles ( file : INTEGER );
  685.  
  686.     VAR strDlg : sd.StrDlg; extension : Data.Extension;
  687.  
  688.     BEGIN (* DoSetupFiles *)
  689.       NEW (strDlg);
  690.       IF strDlg # NIL THEN
  691.         sd.InitStrDlg
  692.           ( strDlg, renderInfo, "Setup Files", "Enter extension",
  693.             Data.ExtensionChars, Data.ExtensionChars);
  694.         extension := Data.extensions [file];
  695.         IF sd.Activate (strDlg, window, extension) THEN
  696.           Data.extensions [file] := extension; ResetGadgets ()
  697.         END;
  698.         SYS.DISPOSE (strDlg)
  699.       ELSE
  700.         ShowMessage (OutOfMemory)
  701.       END
  702.     END DoSetupFiles;
  703.  
  704.   (*------------------------------------*)
  705.   PROCEDURE DoSetupButtons (toolNo : INTEGER);
  706.  
  707.     CONST DisableFlag = {is.gdDisabled}; NoFlag = {};
  708.  
  709.     VAR ignore : LONGINT; toolDialog : td.Dialog;
  710.  
  711.   BEGIN (* DoSetupButtons *)
  712.     td.MakeDialog (toolDialog);
  713.     td.Activate (toolDialog, Data.tools [toolNo], window);
  714.     IF toolDialog.accepted THEN
  715.       isu.DisableGadget
  716.         ( gadgetList, ButtonsID + toolNo,
  717.           ~Data.tools [toolNo].isActive )
  718.     END;
  719.     td.FreeDialog (toolDialog);
  720.   END DoSetupButtons;
  721.  
  722.  
  723.   (*------------------------------------*)
  724.   PROCEDURE DoSaveSetup ();
  725.  
  726.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  727.  
  728.   BEGIN (* DoSaveSetup *)
  729.     tempFile := setupFile; tempDir := setupDir;
  730.     IF ASLUtil.RequestFile (window, "Save setup to...", tempFile, tempDir)
  731.     THEN
  732.       setupFile := tempFile; setupDir := tempDir;
  733.       Data.SaveSetup (tempDir, tempFile)
  734.     END; (* IF *)
  735.   END DoSaveSetup;
  736.  
  737.  
  738.   (*------------------------------------*)
  739.   PROCEDURE DoLoadSetup ();
  740.  
  741.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  742.  
  743.   BEGIN (* DoLoadSetup *)
  744.     tempFile := setupFile; tempDir := setupDir;
  745.     IF ASLUtil.RequestFile (window, "Load setup from...", tempFile, tempDir)
  746.     THEN
  747.       setupFile := tempFile; setupDir := tempDir;
  748.       Data.LoadSetup (tempDir, tempFile); ResetGadgets ()
  749.     END;
  750.   END DoLoadSetup;
  751.  
  752. BEGIN (* HandleMenuPick *)
  753.   result := ev.Continue;
  754.  
  755.   menuNumber := msg.code;
  756.   window := msg.idcmpWindow;
  757.   e.ReplyMsg (msg);
  758.  
  759.   WHILE menuNumber # i.menuNull DO
  760.     iu.GetMenuChoice (menuNumber, window.menuStrip^, menuChoice);
  761.  
  762.     CASE menuChoice.menuChosen OF
  763.       FPEID :
  764.         CASE menuChoice.itemChosen OF
  765.           AboutItemID : DoAbout();
  766.           |
  767.           QuitItemID  : result := ev.StopAll;
  768.           |
  769.         END; (* CASE menuChoice.itemChosen *)
  770.       |
  771.       ProgramID :
  772.         CASE menuChoice.itemChosen OF
  773.           CreateDirID        : DoCreateDir()
  774.           |
  775.           OpenItemID         : DoOpen();
  776.           |
  777.           AddModuleItemID    : DoAddModule();
  778.           |
  779.           RemoveModuleItemID : DoRemoveModule();
  780.           |
  781.           SaveItemID         : DoSave();
  782.           |
  783.         END; (* CASE menuChoice.itemChosen *)
  784.       |
  785.       SetupID :
  786.         CASE menuChoice.itemChosen OF
  787.           SaveSetupItemID :
  788.             CASE menuChoice.subItemChosen OF
  789.               SaveDefaultID : Data.SaveDefSetup (TRUE);
  790.               |
  791.               SaveAltID : Data.SaveDefSetup (FALSE);
  792.               |
  793.               SaveSelectID : DoSaveSetup ();
  794.               |
  795.             END; (* CASE menuChoice.subItemChosen *)
  796.           |
  797.           LoadItemID      :
  798.             CASE menuChoice.subItemChosen OF
  799.               LoadDefaultID :
  800.                 Data.LoadDefSetup (TRUE); ResetGadgets ()
  801.               |
  802.               LoadAltID :
  803.                 Data.LoadDefSetup (FALSE); ResetGadgets ()
  804.               |
  805.               LoadSelectID : DoLoadSetup ();
  806.               |
  807.             END; (* CASE menuChoice.subItemChosen *)
  808.           |
  809.           ButtonsItemID   :
  810.             DoSetupButtons (menuChoice.subItemChosen)
  811.           |
  812.           FilesItemID     :
  813.             DoSetupFiles (menuChoice.subItemChosen)
  814.           |
  815.         END; (* CASE menuChoice.itemChosen *)
  816.       |
  817.     END; (* CASE menuChoice.menuChosen *)
  818.  
  819.     menuNumber := menuChoice.pointer.nextSelect;
  820.   END; (* WHILE *)
  821.  
  822.   RETURN result;
  823. END HandleMenuPick;
  824.  
  825.  
  826. (*------------------------------------*)
  827. PROCEDURE Start * ();
  828.  
  829. BEGIN (* Start *)
  830.   NEW (handler); ASSERT (handler # NIL, 132);
  831.   setupDir := "FPE:S";
  832.   setupFile := "Default.fpe";
  833.  
  834.   i.OldModifyIDCMP (window, IDCMPFlags);
  835.   handler.AttachPort (window.userPort);
  836.   DoLoadProgram (Data.programName);
  837.   ev.SimpleLoop (handler, 500);
  838.   handler.DetachPort ()
  839. END Start;
  840.  
  841. END FPEDlg.
  842.  
  843. (***************************************************************************
  844.  
  845.   $Log: FPEDlg.mod $
  846.   Revision 1.16  1995/06/29  18:49:53  fjc
  847.   - Release 1.6
  848.  
  849.   Revision 1.15  1995/06/15  18:25:58  fjc
  850.   - Bumped revision date.
  851.  
  852.   Revision 1.14  1995/06/04  22:44:57  fjc
  853.   - Changed rendering pens
  854.  
  855.   Revision 1.12  1995/02/07  20:13:27  fjc
  856.   - Release 1.5 update 1
  857.  
  858.   Revision 1.11  1995/01/26  00:15:33  fjc
  859.   - Release 1.5
  860.  
  861.   Revision 1.10  1994/09/25  18:20:54  fjc
  862.   - Uses new syntax for external code declarations
  863.  
  864.   Revision 1.9  1994/08/08  16:14:57  fjc
  865.   Release 1.4
  866.  
  867.   Revision 1.8  1994/06/21  22:09:15  fjc
  868.   - Added code to conditionally call asl.library instead of
  869.     arp.library.
  870.  
  871.   Revision 1.7  1994/06/17  17:26:27  fjc
  872.   - Updated for release
  873.  
  874.   Revision 1.6  1994/06/09  13:36:47  fjc
  875.   - Incorporated changes in Amiga interface.
  876.   - Bumped version strings.
  877.  
  878.   Revision 1.5  1994/06/04  23:49:52  fjc
  879.   - Changed to use new Amiga interface
  880.  
  881.   Revision 1.4  1994/05/19  23:45:35  fjc
  882.   - Added "Program-Create Directory" menu item
  883.  
  884.   Revision 1.3  1994/05/12  21:26:09  fjc
  885.   - Prepared for release
  886.  
  887.   Revision 1.2  1994/01/24  14:33:33  fjc
  888.   Changed to conform with changes in Module Handlers:
  889.     Handler procedures now reply to any messages they handle
  890.   Modified About requester
  891.  
  892.   Revision 1.1  1994/01/15  17:32:38  fjc
  893.   Start of revision control
  894.  
  895. ***************************************************************************)
  896.